COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
C00004 00003	! halprn
C00016 00004	! pvdo & pvldo
C00020 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC

	ENTRY;

BEGIN  "HALPRN"

    IFCR ¬DECLARATION(CREFFING) THENC DEFINE CREFFING="FALSE"; ENDC
    IFCR ¬ CREFFING THENC
	REQUIRE "HALREQ.HDR[HAL,HE]" SOURCE_FILE;
    ENDC
    REDEFINE $$PRGID "[]" = ["HALPRN"];
    IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE; ENDC
ENDC


INITIALIZE(INITIALIZE_OUTPUT);

INTERNAL INTEGER PSPCIX;INITIALIZE(PSPCIX←0);

INTERNAL SIMPLE PROCEDURE PRCRLF(INTEGER OPF(0));
	BEGIN
	$PRINT(CRLF,OPF);
	$PRINT( ("                      "
		&"                      ")[1 FOR PSPCIX],OPF);
	END;


INTERNAL SIMPLE STRING PROCEDURE CVRAD(REAL W);
	RETURN(CVF(W/π)&"*π");

INTERNAL SIMPLE STRING PROCEDURE CVDEG(REAL W);
	RETURN(CVF(W*(180./π))&"*DEG");

INTERNAL SIMPLE STRING PROCEDURE CVGX(REAL R);
	RETURN(TBLKSUPPRESS(CVG(R)));

STRING PROCEDURE LBLID(RPTR(LBLVAR) LBL);
	RETURN(IF LBL=NULL_RECORD THEN "<nameless>" ELSE
		ITMNAM(LBLVAR:NAME[LBL]));
! halprn;

INTERNAL RECURSIVE STRING PROCEDURE HALPRN(RANY S;INTEGER OPF(0));
	BEGIN "HALPRN"
	LABEL REPRINT,XIT,HALPR2;
	INTEGER ST;
	RCELL C;

	RECURSIVE PROCEDURE HPFIN(RCELL C;INTEGER OPF(0));
		BEGIN
		PSPCIX←PSPCIX+1;
		WHILE C≠NULL_RECORD DO HALPRN(LLOP(C));
		PRCRLF(OPF);
		PSPCIX←PSPCIX-1;
		END;

REPRINT:
	ST←RECTYPE(S);
	
	IF ST=LOC(SVAL) THEN
		$PRINT(CVF(SVAL:VAL[S]),OPF)
	ELSE IF ST=LOC(V3ECT) THEN
		BEGIN
		BOOLEAN PROCEDURE VPRINT(RPTR(V3ECT) V,NV;STRING ID);
			BEGIN
			RANY SS; ! because of SAIL dryrot;
			SS←S;
			IF V3DIST(SS,V)=0 THEN $PRINT(" "&ID,OPF)
			ELSE IF V3DIST(SS,NV)=0 THEN $PRINT("-"&ID,OPF)
			ELSE RETURN(FALSE);
			RETURN(TRUE);
			END;
		IF ¬VPRINT(NILVECT,NILVECT,"NILVECT") ∧
		   ¬VPRINT(XHAT,NEGXHAT,"XHAT") ∧
		   ¬VPRINT(YHAT,NEGYHAT,"YHAT") ∧
		   ¬VPRINT(ZHAT,NEGZHAT,"ZHAT") THEN
			    $PRINT(" VECTOR(" & CVGX(V3ECT:X[S]) &
				"," & CVGX(V3ECT:Y[S]) &
				"," & CVGX(V3ECT:Z[S]) & ")"  );
		END
	ELSE IF ST=LOC(ROTN) THEN
		BEGIN
		IF S=NILROTN THEN
			$PRINT(" NILROTN",OPF)
		ELSE
			BEGIN
			$PRINT(" ROTN( ",OPF);
			HALPRN(ROTN:AXIS[S],OPF);
			$PRINT(","&CVDEG(ROTN:MAGN[S])&")",OPF);
			END;
		END
	ELSE IF ST=LOC(TRANS) THEN
		BEGIN  !  Modified by RF;
		IF S=NILTRANS THEN
			$PRINT(" NILTRANS",OPF)
		ELSE
			BEGIN
			$PRINT(" TRANS(",OPF);
			HALPRN(TRANS:R[S],OPF);
			$PRINT(",",OPF);
			HALPRN(TRANS:P[S],OPF);
			$PRINT(")",OPF);
			END;
		END
	ELSE IF ST=LOC(FRAME) THEN
		BEGIN  !  Modified by RF;
		IF S=STATION THEN
			$PRINT(" STATION",OPF)
		ELSE BEGIN
			$PRINT(" FRAME(",OPF);
			HALPRN(TRANS:R[FRAME:VAL[S]],OPF);
			$PRINT(",",OPF);
			HALPRN(TRANS:P[FRAME:VAL[S]],OPF);
			$PRINT(")",OPF);
			END;
		END
	ELSE IF ST=LOC(VARIABLE) THEN 
		BEGIN
		$PRINT(" "&ITMNAM(VARIABLE:NAME[S]),OPF);
		END
	ELSE IF ST=LOC(STCONST) THEN 
		BEGIN
		$PRINT(" "&DATUM(STCONST:VAL[S]),OPF);
		END
	ELSE IF ST=LOC(EXPRN) THEN
		BEGIN
		$PRINT("("&OP_MNE[EXPRN:OP[S]],OPF);
		C←EXPRN:ARGS[S];
		WHILE C≠NULL_RECORD DO HALPRN(LLOP(C));
		$PRINT(")",OPF);
		END
	ELSE IF ST=LOC(VNODE) THEN
		BEGIN
		$PRINT("[INV="&CVS(VNODE:INVMARK[S])&",VAL=",OPF);
		HALPRN(VNODE:NOMVAL[S],OPF);
		$PRINT("]",OPF);
		END
	ELSE IF ST=LOC(CALCULATOR) THEN
		BEGIN
		$PRINT("( calc "&LBLID(CALCULATOR:LBL[S])&": ",OPF);
		HALPRN(CALCULATOR:FORM[S],OPF);
		$PRINT(")",OPF);
		END
	ELSE IF ST=LOC(CHANGER) THEN
		BEGIN
		$PRINT("(changer "&LBLID(CHANGER:LBL[S])&": ",OPF);
		HALPRN(CHANGER:CODE[S],OPF);
		$PRINT(")",OPF);
		END
	ELSE IF ST=LOC(STMNT) THEN
		BEGIN
		HALPRN(STMNT:SEMANTICS[S],OPF);
		$PRINT(" [IW="&ITMNAM(STMNT:IW[S])&",OW="
					&ITMNAM(STMNT:OW[S])&"]",OPF);
		END
	ELSE IF ST=LOC(AFACT) THEN
		BEGIN
		$PRINT("(",OPF);
		HALPRN(AFACT:LEFT[S],OPF);
		$PRINT(" "&("<≤=≥>"[AFACT:RELN[S]+3 FOR 1]),OPF);
		HALPRN(AFACT:RIGHT[S],OPF);
		$PRINT(")",OPF);
		END
	ELSE IF ST=LOC(SFACT) THEN
		BEGIN
		$PRINT(" FACT ",OPF);
		S←SFACT:PATT[S];
		GO TO REPRINT;
		END
	ELSE IF ST=LOC(CELL) THEN
		BEGIN
		$PRINT("(",OPF);
		WHILE S≠NULL_RECORD DO
			BEGIN
			HALPRN(CELL:CAR[S],OPF);
			S←CELL:CDR[S];
			END;
		$PRINT(" )",OPF);
		END
	ELSE IF ST=0 THEN
		$PRINT(" NULL_RECORD ",OPF)
        ELSE IF ST=LOC(CMON) THEN
                BEGIN
		!  Recoded by RF;
		$PRINT(" (ON ",OPF);
		HALPRN(CMON:CONDITION[S],OPF);
		$PRINT(" DO ",OPF);
		HALPRN(CMON:CONCLUSION[S],OPF);
		$PRINT(" )",OPF);
                END
        ELSE IF ST = LOC(EVDO) THEN
                BEGIN  ! Added by RF;
                IF EVDO:OP[S] = 0
                THEN $PRINT("(SIGNAL ",OPF)
                ELSE $PRINT("(WAIT ",OPF);
                HALPRN(EVDO:VAR[S],OPF);
                $PRINT(")",OPF);
                END
	ELSE
		BEGIN
		GO TO HALPR2;
		! this admittedly ugly goto statement is here
		  because otherwise you have to use a bigger 
		  parse stack in compiling this program, which
		  is a real pain. ;
		END;
	GO TO XIT; ! see the remark immediately above;
	HALPR2: BEGIN
		PRCRLF(OPF);
		$PRINT("("&CVRTS(ST),OPF);
		IF ST=LOC(BLOCK)∨ST=LOC(COBLOCK) THEN
			BEGIN
			IF ST=LOC(BLOCK)
			    THEN BEGIN  ! Modified by RF;
			    C ← BLOCK:VARS[S];
			    HPFIN(C,OPF);
			    C ← BLOCK:CODE[S];
			    END
			ELSE IF ST=LOC(COBLOCK) THEN
				C←COBLOCK:CODE[S];
			HPFIN(C,OPF);
			END
		ELSE IF ST=LOC(PROG) THEN
			BEGIN
			HALPRN(PROG:CODE[S],OPF);
			END
		ELSE IF ST=LOC(ASSIGNMENT) THEN
			BEGIN
			HALPRN(ASSIGNMENT:VAR[S],OPF);
			$PRINT(" ",OPF);
			HALPRN(ASSIGNMENT:VAL[S],OPF);
			END
		ELSE IF ST=LOC(GASSIGN) THEN
			BEGIN
			HALPRN(GASSIGN:VAR[S],OPF);
			$PRINT("=≠<"[GASSIGN:OP[S] FOR 1],OPF);
			HALPRN(GASSIGN:CLC[S],OPF);
			END
		ELSE IF ST=LOC(ASSERT)∨ST=LOC(DENY) THEN
			BEGIN
			HALPRN(ASSERT:FACT[S],OPF);
			$PRINT(" IN "&ITMNAM(ASSERT:WLD[S]),OPF);
			END
		ELSE IF ST=LOC(MOVE$) THEN
			BEGIN
			HALPRN(MOVE$:WHAT[S],OPF);
			$PRINT(" TO ",OPF);
			HALPRN(MOVE$:DEST[S],OPF);
			IF MOVE$:CLAUSES[S]≠NULL_RECORD THEN
				BEGIN
				PSPCIX←PSPCIX+1;
				PRCRLF(OPF);
				HPFIN(MOVE$:CLAUSES[S],OPF);
				PSPCIX←PSPCIX-1;
				END;
			END
		ELSE IF ST=LOC(CENTER) THEN
			BEGIN
			HALPRN(CENTER:CF[S],OPF);
			IF CENTER:CLAUSES[S]≠NULL_RECORD THEN
				BEGIN
				PSPCIX←PSPCIX+1;
				PRCRLF(OPF);
				HPFIN(CENTER:CLAUSES[S],OPF);
				PSPCIX←PSPCIX-1;
				END;
			END
		ELSE IF ST=LOC(PVL) THEN
			HALPRN(PVL:VL[S],OPF)
		ELSE IF ST=LOC(IFF) THEN
			BEGIN
			HALPRN(IFF:COND[S],OPF);
			PSPCIX←PSPCIX+1;
			HALPRN(IFF:THN[S],OPF);
			HALPRN(IFF:ELS[S],OPF);
			PRCRLF(OPF);
			PSPCIX←PSPCIX-1;
			END
		ELSE IF ST = LOC(WHIL) THEN
			BEGIN
			HALPRN(WHIL:COND[S],OPF);
			PSPCIX←PSPCIX+1;
			PRCRLF(OPF);
			HALPRN(WHIL:BODY[S],OPF);
			PSPCIX←PSPCIX-1;
			END
                ELSE IF ST = LOC(VIA) THEN
                        BEGIN "via"
                        HALPRN(VIA:PLACE[S],OPF);
                        IF VIA:VELOC[S] ≠ RNULL THEN HALPRN(VIA:VELOC[S],OPF);
                        IF VIA:TIME[S] ≠ RNULL THEN HALPRN(VIA:TIME[S],OPF);
                        IF VIA:CODE[S] ≠ RNULL THEN HALPRN(VIA:CODE[S],OPF);
                        END "via"
                ELSE IF ST = LOC(DURATION) THEN
                        BEGIN "duration"
                        $PRINT(CASE DURATION:TIME_RELN[S] OF
			    (" ? "," > "," < "," = "));
                        HALPRN(DURATION:TIME[S],OPF);
                        END "duration"
                ELSE IF ST = LOC(PRNT) THEN
			HALPRN(PRNT:VAL[S],OPF)
                ELSE IF ST = LOC(STOP) THEN
			HALPRN(STOP:CF[S],OPF)
		ELSE
			BEGIN
			PRNREC(S,OPF);
			END;
		$PRINT(")",OPF);
		END;
XIT:	RETURN(NULL);
	END "HALPRN";

PROCEDURE INIPFS;
	BEGIN
	INTEGER HPL;
	HPL←LOC(HALPRN);
	RPMETH(LOC(FRAME),HPL);
	RPMETH(LOC(TRANS),HPL);
	RPMETH(LOC(ROTN),HPL);
	RPMETH(LOC(STMNT),HPL);
	RPMETH(LOC(BLOCK),HPL);
	RPMETH(LOC(VARIABLE),HPL);
	RPMETH(LOC(CHANGER),HPL);
	RPMETH(LOC(CALCULATOR),HPL);
	RPMETH(LOC(EXPRN),HPL);
	END;

REQUIRE INIPFS INITIALIZATION;
! pvdo & pvldo;

PROCEDURE ATLPRT(ITEMVAR W;STRING ATTID;RPTR(SET_FLUENT) ATTFL;INTEGER OPF);
        BEGIN
        INTEGER FLG;
        RANY VV;
	PRCRLF(OPF);
        $PRINT(TAB&ATTID&"=",OPF);
        PSPCIX←PSPCIX+10;
        FLG←0;
        ∀ | SATISFY_SET_FLUENT(W,ATTFL,VV) DO
                BEGIN
		IF FLG THEN
	                PRCRLF(OPF);
                HALPRN(VV,OPF);
                FLG←1;
                END;
        IF ¬FLG THEN $PRINT(" <NONE> ",OPF);
        PSPCIX←PSPCIX-10;
        END;

INTERNAL PROCEDURE PCDO(RPTR(CALCULATOR) V;ITEMVAR WLD;INTEGER OPF(0));
	BEGIN

	! prints out a "pretty" version of the graph node
	for calculator V in world WLD.  OPF is the $PRINT control word;

	RPTR(VNODE) GN;
	GN←GETFREC(CALCULATOR:PLNVAL[V],WLD);
	PRCRLF(OPF);
	$PRINT("IN WORLD "&ITMNAM(WLD)&", CALCULATOR "&LBLID(CALCULATOR:LBL[V])&
			" HAS GRAPH PROPERTIES:",OPF);
	PSPCIX←PSPCIX+10;
	PRCRLF(OPF);
	$PRINT("VALUE NODE =",OPF);
	HALPRN(GN,OPF);
	PSPCIX←PSPCIX-10;
	PRCRLF(OPF);
	ATLPRT(WLD,"DEPS",CALCULATOR:DEPS[V],OPF);
	PRCRLF(OPF);
	END;

INTERNAL PROCEDURE PVDO(RPTR(VARIABLE) V;ITEMVAR WLD;INTEGER OPF(0));
	BEGIN

	! prints out a "pretty" version of the graph node
	for variable VAR in world WLD.  OPF is the $PRINT control word;

	RPTR(VNODE) GN;
	RPTR(CALCULATOR) C;
	BOOLEAN FLG;

	GN←GETFREC(VARIABLE:PLNVAL[V],WLD);
	PRCRLF(OPF);
	$PRINT("IN WORLD "&ITMNAM(WLD)&", "
		&ITMNAM(VARIABLE:NAME[V])
		&" HAS GRAPH PROPERTIES:",OPF);
	PSPCIX←PSPCIX+10;
	PRCRLF(OPF);
	$PRINT("VALUE NODE =",OPF);
	HALPRN(GN,OPF);
	PSPCIX←PSPCIX-10;
	ATLPRT(WLD,"DEPS",VARIABLE:DEPS[V],OPF);
	ATLPRT(WLD,"CALCS",VARIABLE:CALCS[V],OPF);
	ATLPRT(WLD,"CHANGERS",VARIABLE:CHANGERS[V],OPF);
	PRCRLF(OPF);
	PSPCIX←PSPCIX+10;
	∀ | SATISFY_SET_FLUENT(WLD,VARIABLE:CALCS[V],C) DO
		BEGIN
		PCDO(C,WLD,OPF);
		FLG←TRUE;
		END;
	PSPCIX←PSPCIX-10;
	PRCRLF(OPF);
	END;

INTERNAL PROCEDURE PVLDO(RCELL C;ITEMVAR WLD;INTEGER OPF(0));
	BEGIN
	WHILE C≠NULL_RECORD DO 
		BEGIN
		PVDO(CHKREC(CELL:CAR[C],LOC(VARIABLE)),WLD,OPF);
		C←CELL:CDR[C];
		END;
	END;

END $$PRGID;